home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
postogrf.zip
/
EXTRAMEN.INC
< prev
next >
Wrap
Text File
|
1990-05-31
|
6KB
|
154 lines
{ ExtraMen.inc include file for Postogrf
14 Dec 89
}
procedure ExtraMenu;
const HelpStr =
'F1 expand F2 contract F5 rotate label F10 VG Format';
{ -------------------------------------------------------------------
Draw box centered at screen center + (x,y).
Expand.ScrnW, Expand.ScrnH. The size equals the (scaled down) size
that the screen will have AFTER this expansion operation is
completed. x, y are actual screen coordinates.
------------------------------------------------------------------- }
Procedure CenterBox(x,y:integer);
var x1, x2, y1, y2, tSF: integer;
begin
if VidCol = color then SetColor(yellow) else SetColor(white);
with Expand do begin
x1 := x + GetMaxX div 4;
y1 := y + GetMaxY div 4;
x2 := x1 + GetMaxX div 2;
y2 := y1 + GetMaxY div 2;
end;
Rectangle( x1, y1, x2, y2);
end;
{ ------------------------------------------------------------------
Show crosshairs, move them with cursor keys, to select new center
for expansion of view. User quits with <ESC> or <CR>.
Return false if user exited by <ESC>, true otherwise.
Changes Expand.XCent, Expand.YCent.
------------------------------------------------------------------ }
function NewCenter: boolean;
const HelpStr =
'move crosshairs to new viewpoint. <ENTER> to change, <ESC> to quit';
var tcolor: word;
tx, ty, offset: integer;
key: char;
moving: boolean;
begin
clrscr;
Write(HelpStr);
offset := 0;
with Expand do begin
tx := 0;
ty := 0;
SetWriteMode(XorPut);
CenterBox(tx, ty); {show box - the 1st time}
repeat
key := readkey;
moving := false;
if key = #0 then repeat
if not moving then key := readkey;
CenterBox(tx, ty); {erase box}
case key of {function keys}
RightArrow: begin inc(tx);
end;
LeftArrow: begin dec(tx);
end;
UpArrow: begin dec(ty);
end;
DownArrow: begin inc(ty);
end;
(* CNTRL -> *) #116: tx := tx + 10;
(* CNTRL <- *) #115: tx := tx - 10;
(* page up *) #73 : ty := ty - 10;
(* page down *) #81 : ty := ty + 10;
Home : begin
tx := 0; ty := 0;
end;
end; {case}
CenterBox(tx, ty); {show box in new place}
if keypressed then begin
repeat key := readkey; until (not keypressed) ;
moving := true;
end else begin
delay(50);
if keypressed then begin
key := readkey; moving := true;
end else moving := false;
end;
until not moving ;
until (key = ESC) or (key = CR);
CenterBox(tx, ty); {kill box for final time}
SetWriteMode(CopyPut);
if key = CR then begin
XCent := XCent + tx div SF;
YCent := YCent + ty div SF;
NewCenter := true;
end else NewCenter := false;
end; {with Expand do...}
end; {NewCenter}
begin
clrscr;
Write(HelpStr);
repeat key := readkey;
until (key = #0) or (key = ESC) or (key = CR);
if key = #0 then key := readkey;
with Expand do
case key of {function keys}
PF1: if NewCenter then begin
clrscr;
SF := SF * 2;
ScrnW := ScrnW div 2; ScrnH := ScrnH div 2;
ClearViewPort; RePaint;
end;
PF2: if SF > 1 then begin
clrscr;
SF := SF div 2;
ScrnW := ScrnW * 2;
ScrnH := ScrnH * 2;
ClearViewPort; RePaint;
end else begin
clrscr;
Sf := 1;
Xcent := GetMaxX div 2; Ycent := GetMaxY div 2;
ScrnW := GetMaxX div 2;
ScrnH := GetMaxY div 2;
ClearViewPort; Repaint;
end;
PF5: begin
if select = nil then exit;
select^ := tempText;
ShowLabel(select, black);
UnBoxLabel(select);
ChangeDirection(select);
tempText := select^;
HighLight(select);
end;
PF10: begin LCOnfig.DoBar := not Lconfig.DOBar;
if not noshow then begin
{SetWriteMode(XORPut);}
SetWriteMode(copyput);
setcolor(black);
ShowCopyBlock;
if vidcol = color then SetColor(yellow);
end;
SetWriteMode(CopyPut);
VGFormat;
SetCopyBlockDef;
noshow := false;
{SetWriteMode(XORPut);}
if vidcol = color then setcolor(yellow);
ShowCopyBLock;
SetWriteMode(CopyPut);
setcolor(white);
saved := false;
end;
end; {case}
key := #0;
end;